Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/UNITS/PBEXEC.PAS

Pascal/Delphi Source File | 1994-05-03 | 7KB | 252 lines

{SECTION ..PbEXEC }
UNIT PbEXEC;

INTERFACE

uses DOS, PbMISC, PbDATA, PbPARMS;

{
Description:  Interface to PKZIP, TPC and Various Command.com functions

Author      : Howard Richoux
Date        :  8/2/90
Last revised: 12/15/93 hnr trivial re-formatting
               2/18/94 hnr new libraries
Application : IBM PC and compatibles, Turbo Pascal 7.0
Status      : Placed in the Public Domain by HNR Software 2/18/94
Published in: none
}



var ZIPError          : integer;



Procedure CleanUpDir(WorkDir, FileMask : string);
                   {[FILE] Erases files based on a mask }

Procedure DisplayZIPError;
                   {[EXEC] PKZip interface }

Procedure DefaultCleanup(WorkDir : string);
                   {[FILE] Erases files *.BAK, *.MAP, temp*.*}


Procedure ParmCleanup(WorkDir : string);
                   {[FILE] Erases files based on param file}

Procedure ShowEraseStats;
                   {[FILE] shows count & bytes recovered}

Function  UnZIPFile( op, ZIPName, DPath, fspec : string; qt : boolean) : boolean;
                   {[EXEC] Uses PKUnZip to de-archive files }

Function  ZIPFile( op, ZIPName, fspec  : string; qt : boolean) : boolean;
                   {[EXEC] Uses PKZip to archive files }



{SECTION .zImplementation }
IMPLEMENTATION

{-}

var  ZIPDefaultop      : string[16];
var  ZIPFileName       : string[50];
var  ZIPDPath          : string[50];

var  EraseCount        : Word;        { files erased }
     EraseSizeK        : LongInt;     { kilobytes released by erasing files }


{SECTION  CleanUpDir }
Procedure CleanUpFile(WorkDir : string; SR : searchRec);
var l    : longint;
    begin
    with SR do
        begin
        l := size div 512;
        if (attr and 31) = 0 then
            begin
            if l = 0 then l := 1;
            EraseSizeK := EraseSizeK + l;
            writeln('         Removing: ',(AddBackSlash(WorkDir)+name),
                    '   ',l div 2,'k');
            EraseFile(AddBackSlash(WorkDir)+name);
            inc(EraseCount);
            end
        else writeln(' ??  ',(AddBackSlash(WorkDir)+name),'   ',l div 2,'k',
                     '  attr: ',attr);
        end;
    end;


Procedure CleanUpDir(WorkDir, FileMask : string);
var Frec : SearchRec;
    s    : string[64];
    begin
    s := '';
    findfirst(AddBackSlash(WorkDir)+FileMask, anyfile, Frec);
    while doserror = 0 do
        begin
        CleanUpFile(WorkDir, Frec);
        findnext(Frec);
        end;
    end;


{SECTION  DefaultCleanup }
Procedure DefaultCleanup(WorkDir : string);
    begin
    CleanUpDir(WorkDir,'*.BAK');
    CleanUpDir(WorkDir,'*.MAP');
    CleanUpDir(WorkDir,'TEMP*.*');
    end;


{SECTION  DisplayZIPError }
Procedure DisplayZIPError;
    begin
    case ziperror of
        0       : writeln('no error');
        1..90   : writeln(ziperror:3,' Exec DOS error ');
        98      : writeln(ziperror:3,' requested file not produced ');
        99      : writeln(ziperror:3,' archive file not found');
        end;
    end;


{SECTION  PbEXECInit }
Procedure PbEXECInit;
     begin
     ZIPError        := 0;
     ZIPDefaultop    := '-n';
     ZIPFileName     := 'NOFILE.ZIP';
     ZIPDPath        := '';
     EraseCount  := 0;
     EraseSizeK  := 0;
     end;


{SECTION  ParmCleanup }
Procedure ParmCleanupItem(Workdir : string; Item : integer);
var itemstr : string[10];
    parmname,maskname   : string[40];
    begin
    str(item:1,itemstr);
    parmname := 'CLEANUP' + itemstr;
    if GetParmStr(parmname) <> '' then
         begin
         maskname := GetParmStr(parmname);
         writeln('  Cleaning up ',maskname);
         CleanUpDir(WorkDir,maskname);
         end;
    end;


Procedure ParmCleanup(WorkDir : string);
var i : integer;
    begin
    writeln('Cleaning up   ',WorkDir);
    for i := 1 to 10 do
        ParmCleanUpItem(WorkDir,i);
    end;




{SECTION  ShowEraseStats }
Procedure ShowEraseStats;
    {-Show statistics at the end of run}
    begin
    WriteLn('Files Erased: ', EraseCount,
            '  bytes used: ',EraseSizeK div 2,'k');
    end;


{SECTION  UnZIPFile }
Function  UnZIPFile( op, ZIPName, DPath, fspec : string; qt : boolean) : boolean;
var s,zname     : string;
    i,j         : integer;
    begin
    ZIPError       := 0;
    UnZIPFile := true;
    s := 'PKUNZIP ';
    if op <> '' then  s := s + op
    else                   s := s + ZIPDefaultop;

    if ZIPName <> '' then  zname := ZIPName
    else                   zname := ZIPFileName;
    if not FileExists(zname) then
        begin
        writeln('zname: [',zname,']');
        UnZIPFile := false;
        ZIPError := 99;
        exit;
        end;
    s := s + ' ' + zname;

    if DPath <> '' then s := s + ' ' + DPath
    else                   s := s + ' ' + ZIPDPath;
    s := s + ' ' + fspec;
    if qt then s := s + ' >NUL ';
    ZIPError := ExecuteCommand(s);
    if ZIPError > 0 then
         begin
         writeln('PKUNZIP start failed ',ZIPError,' [',s,']');
         UnZIPFile := false;
         end
    else begin
         i := pos('*',fspec);
         j := pos('?',fspec);
         if (i = 0) and (j = 0) then
             begin
             if not FileExists(DPath + fspec) then
                  begin
                  UnZIPFile := false;
                  ZIPError := 98;
                  end;
             end;
         end;
    end;



{SECTION  ZIPFile }
Function  ZIPFile( op, ZIPName, fspec  : string; qt : boolean) : boolean;
var s,zname     : string;
    i,j         : integer;
    begin
    ZIPError       := 0;
    ZIPFile := true;
    s := 'PKZIP ';
    if op <> '' then  s := s + op
    else                   s := s + ZIPDefaultop;

    if ZIPName <> '' then  zname := ZIPName
    else                   zname := ZIPFileName;
    s := s + ' ' + zname;
    s := s + ' ' + fspec;
    if qt then s := s + ' >NUL ';
    ZIPError := ExecuteCommand(s);
    if ZIPError > 0 then
         begin
         writeln('PKZIP start failed ',ZIPError,' [',s,']');
         ZIPFile := false;
         end
    else begin
         if not FileExists(ZIPname+'.ZIP') then
              begin
              ZIPFile := false;
              ZIPError := 98;
              end;
         end;
    end;


{SECTION zzInitialization  }
     begin {Initialization}
     PbEXECInit;
     end.